      SUBROUTINE SETUP
      RETURN
      END
C   HS88
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),FX,S
      ICF=ICF+1
      S=0.D0
      DO      100      I=1,N
      S=S+X(I)**2
  100 CONTINUE
      FX=S
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADF(NX)
      ICGF=ICGF+1
      DO      100      I=1,N
      GRADF(I)= 2.D0*X(I)
 100  CONTINUE
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI
      CRES(I)=CRES(I)+1
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADHI(NX)
      CGRES(I)=CGRES(I)+1
      RETURN
      END
      SUBROUTINE EG(II,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER II,I,J,IFALL,I1
      DOUBLE PRECISION GXI
      COMMON/SPEZIAL/IFALL
      DOUBLE PRECISION XM,XM2,A,D,E,C
      COMMON /FU/ XM(30),XM2(30),A(30),D(30),E(30),C(30,30)
      DOUBLE PRECISION X(NX),B(7),S(7),R(30),SU,SU1
      SAVE B, /SPEZIAL/, /FU/
      DATA B/1.D0,-2.D0,1.D0,4*0.D0/
      IF ( GUNIT(1,II+NH) .EQ. -1 )CRES(II+NH)=CRES(II+NH)+1
      IF(IFALL .GT. 1)      GOTO 100
      CALL SSTART
      IFALL=2
  100 CONTINUE
      S(N+1)=0.D0
      DO      200      I=1,N
      J=N-I+1
      S(J)=S(J+1)+X(J)**2
  200 CONTINUE
      DO      400      I=1,30
      SU=B(N+1)
      DO      300      J=1,N
      SU=SU+B(J)*DEXP(-XM2(I)*S(J))
  300 CONTINUE
      R(I)=-SU/XM2(I)
  400 CONTINUE
      SU=1.D0/15.D0
      DO      600      I=1,30
      SU1=E(I)+D(I)*R(I)
      I1=I+1
      IF(I .EQ. 30)      GOTO 550
      DO      500      J=I1,30
      SU1=SU1+C(I,J)*R(J)
  500 CONTINUE
  550 CONTINUE
      SU=SU+SU1*R(I)
  600 CONTINUE
      SU=1.D-4-2.D0*SU
      GXI=SU
      RETURN
      END
      SUBROUTINE EGRADG(II,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER II,I,J,K,I1
      DOUBLE PRECISION XM,XM2,A,D,E,C,SU,SU1,SU2
      COMMON /FU/ XM(30),XM2(30),A(30),D(30),E(30),C(30,30)
      DOUBLE PRECISION X(NX),GRADGI(NX),B(7),S(7),R(30),GR(7,30)
      SAVE B, /FU/
      DATA B/1.D0,-2.D0,1.D0,4*0.D0/
      IF ( GUNIT(1,II+NH) .EQ. 1 )RETURN
      CGRES(II+NH)=CGRES(II+NH)+1
      S(N+1)=0.D0
      DO      100      I=1,N
      J=N-I+1
      S(J)=S(J+1)+X(J)**2
  100 CONTINUE
      DO      300      I=1,30
      SU=B(N+1)
      DO      200      J=1,N
      SU=SU+B(J)*DEXP(-XM2(I)*S(J))
  200 CONTINUE
      R(I)=-SU/XM2(I)
  300 CONTINUE
      DO      500      I=1,30
      SU=0.D0
      DO      400      K=1,N
      SU=SU+B(K)*DEXP(-XM2(I)*S(K))
      GR(K,I)=2.D0*X(K)*SU
  400 CONTINUE
  500 CONTINUE
      DO      900      K=1,N
      SU=0.D0
      DO      800      I=1,30
      SU1=D(I)*GR(K,I)
      SU2=E(I)+D(I)*R(I)
      IF(I .EQ. 30)     GOTO 700
      I1=I+1
      DO      600      J=I1,30
      SU1=SU1+C(I,J)*GR(K,J)
      SU2=SU2+C(I,J)*R(J)
  600 CONTINUE
  700 CONTINUE
      SU=SU+R(I)*SU1+GR(K,I)*SU2
  800 CONTINUE
      GRADGI(K)=-2.D0*SU
  900 CONTINUE
      RETURN
      END
      SUBROUTINE SSTART
      IMPLICIT NONE
      INTEGER I,J,I1
      DOUBLE PRECISION XM,XM2,A,D,E,C,PI,X0M,V1,V2,DS,CS
      COMMON /FU/ XM(30),XM2(30),A(30),D(30),E(30),C(30,30)
      SAVE PI, /FU/
      DATA PI/3.141592653D0/
      X0M=PI*.25D0
      DO     300      I=1,30
      IF(I .GE. 2)    X0M=DBLE(I-1)*PI
      V1=X0M
  100 CONTINUE
      DS=DSIN(V1)
      CS=DCOS(V1)
      V2=V1-(V1*DS-CS)*CS/(V1+DS*CS)
      IF(DABS(V1-V2) .LE. 1.D-12*DABS(V2))   GOTO 200
      V1=V2
      GOTO 100
  200 CONTINUE
      XM(I)=V2
      XM2(I)=V2*V2
      A(I)=2.D0*DS/(V2+DS*CS)
      D(I)=DS*DS*V2*V2*V2/(V2+DS*CS)
      E(I)=-A(I)*(DS-V2*CS)/V2
  300 CONTINUE
      DO    500    I=1,29
      I1=I+1
      DO    400    J=I1,30
      C(I,J)=A(I)*A(J)*XM2(I)*XM2(J)*(XM(I)*DSIN(XM(I))*DCOS(XM(J))
     1       -XM(J)*DCOS(XM(I))*DSIN(XM(J)))/(XM2(I)-XM2(J))
  400 CONTINUE
  500 CONTINUE
      RETURN
      END
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER IFALL,I,J
      COMMON/SPEZIAL/IFALL
      SAVE /SPEZIAL/
      DATA NAME/'HS88'/
      DATA X(1),X(2)/.5D0,-.5D0/
      DATA N/ 2/ , NH/0/ , NG/ 1/,IFALL/1/
      DATA DEL0/1.00D0/ ,TAU0/0.1D0/ ,TAU/.1D0/
      DATA ((GUNIT(I,J),I=1,3),J=0,1)/-1,0,0,-1,0,0/
      END

